// RealPlay Ltd  copyrights.
// This program is Open Source AsIs
// You may use it for all purposes, including commercial
// But!!!
// If you use any part of this code, you must state clearly
// both in your source file and in the Help|about of your program,
// that the origin program or code was built by RealPlay Ltd

// ***********************************************************************/
// *                                                                     */
// *        This file is the XML unit of "Paint" Program                 */
// *                                                                     */
// ***********************************************************************/

unit UP_XML;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, xmldom, XMLIntf, Menus, msxmldom, XMLDoc, ActnList, ActnMan,
  StdCtrls, ComCtrls, Buttons, ExtCtrls;

type
  TFxml = class(TForm)
    XMLDoc: TXMLDocument;
    MainMenu1: TMainMenu;
    MenuFile: TMenuItem;
    MenuFNew: TMenuItem;
    MenuFOpen: TMenuItem;
    MenuFSave: TMenuItem;
    MenuFSaveAS: TMenuItem;
    MenuBar: TMenuItem;
    MenuFExit: TMenuItem;
    Memo1: TMemo;
    TreeView1: TTreeView;
    bX2T: TBitBtn;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    Panel1: TPanel;
    Splitter1: TSplitter;
    procedure MenuFExitClick(Sender: TObject);
    procedure NewClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure bX2TClick(Sender: TObject);
    procedure MenuFSaveAsClick(Sender: TObject);
    procedure MenuFOpenClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure openXMLfile;
  end;

var
  Fxml: TFxml;

const
  version = '0.1';
procedure XML2Tree(tree: TTreeView; XMLDoc: TXMLDocument);

implementation

{$R *.dfm}

procedure TFxml.MenuFExitClick(Sender: TObject);
begin
  Fxml.Close;
end;

procedure TFxml.NewClick(Sender: TObject);
begin
  Memo1.Clear;
  Memo1.Text := '<RealPlay Version="' + version + '" />';
end;

procedure TFxml.FormCreate(Sender: TObject);
begin
  NewClick(self);
end;

procedure TFxml.bX2TClick(Sender: TObject);
begin
  XMLDoc.XML := Memo1.lines;
  XMLDoc.Active := true;
  XML2Tree(TreeView1, XMLDoc);
  XMLDoc.Active := false;
end;

{ ------------------------------- }
procedure XML2Tree(tree: TTreeView; XMLDoc: TXMLDocument);
var
  iNode: IXMLNode;

  procedure ProcessNode(Node: IXMLNode; tn: TTreeNode);
  var
    cNode: IXMLNode;
    tna: TTreeNode;
    i: integer;
    st: string;
  begin
    if Node = nil then
      Exit;
    with Node do
    begin
      tn := tree.Items.AddChild(tn, nodename { Attributes['text'] } );
      if AttributeNodes.Count > 0 then
      begin
        tna := tree.Items.AddChild(tn, 'Attributes');
        for i := 0 to AttributeNodes.Count - 1 do
        begin
          st := AttributeNodes[i].nodename;
          tree.Items.AddChild(tna, st + '=' + Attributes[st]);
        end;
      end;
    end;
    cNode := Node.ChildNodes.First;
    while cNode <> nil do
    begin
      ProcessNode(cNode, tn);
      cNode := cNode.NextSibling;
    end;
  end; (* ProcessNode *)

begin // XML2Tree
  tree.Items.Clear;
  iNode := XMLDoc.DocumentElement; // .ChildNodes.First;
  while iNode <> nil do
  begin
    ProcessNode(iNode, nil);
    iNode := iNode.NextSibling;
  end;

end;

procedure TFxml.MenuFSaveAsClick(Sender: TObject);
begin
  if SaveDialog1.Execute then
    Memo1.lines.SaveToFile(SaveDialog1.filename);
end;

procedure TFxml.openXMLfile;
begin
  try
    XMLDoc.LoadFromFile(OpenDialog1.filename);
  except
    begin
      MessageDlg('The file is not a Valid XML', mtError, [mbOk, mbCancel], 0);
      XMLDoc.Active := false;
      Exit;
    end;
  end;
  Memo1.lines := XMLDoc.XML;
end;

procedure TFxml.MenuFOpenClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
    openXMLfile;
end;

end.
